home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / hyperbole / kotl / klink.el < prev    next >
Encoding:
Text File  |  1995-04-28  |  7.8 KB  |  222 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         klink.el
  4. ;; SUMMARY:      Implicit reference to a kcell action type, for use in koutlines.
  5. ;; USAGE:        GNU Emacs V19 Lisp Library
  6. ;; KEYWORDS:     extensions, hypermedia, outlines, wp
  7. ;;
  8. ;; AUTHOR:       Bob Weiner & Kellie Clark
  9. ;;
  10. ;; ORIG-DATE:    15-Nov-93 at 12:15:16
  11. ;; LAST-MOD:     17-Apr-95 at 11:53:45 by Bob Weiner
  12. ;;
  13. ;; This file is part of Hyperbole.
  14. ;; Available for use and distribution under the same terms as GNU Emacs.
  15. ;;
  16. ;; Copyright (C) 1993-1995, Free Software Foundation, Inc.
  17. ;; Developed with support from Motorola Inc.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;;
  21. ;;   The klink implicit button type defined herein, is used to
  22. ;;   refer to autonumbered kcells and will eventually be used to autonumbered
  23. ;;   journal documents.  Klink buttons invoke the link-to-kotl actype, also
  24. ;;   defined herein.
  25. ;;
  26. ;;   Klinks are delimited by <> characters.  Here is a rough
  27. ;;   description of the syntax, only part of which is implemented as yet.
  28. ;;
  29. ;;; link =
  30. ;;    < pathname [, cell-ref] [, position] [, view] >
  31. ;;    < @cell-ref >  ;; In same buffer
  32. ;;    < journal-name, journal-item-number [, cell-ref] [, position] [,view] >
  33. ;;
  34. ;;; pathname =
  35. ;;    path   ;; display path in Emacs buffer
  36. ;;    !path  ;; execute pathname within a shell
  37. ;;    &path  ;; execute path as a windowed program
  38. ;;    -path  ;; Load as an Emacs Lisp program
  39. ;;
  40. ;;; cell-ref =
  41. ;;    cell - 1a, 012, 1.2, 1a=012 (both relative and absolute ids separated
  42. ;;    by an equal sign)
  43. ;;    range - 1a:5c, 1a:+3 (include 3 cells past 1a)
  44. ;;    kotl - 1a::
  45. ;;
  46. ;;    previous-cell - .b
  47. ;;    down-a-level - .d
  48. ;;    end-of-branch - .e
  49. ;;    follow-next-link - .l
  50. ;;    return-to-prev-location - .r
  51. ;;    return-to-prev-buffer - .rf
  52. ;;    sibling - .s, .2s for 2 siblings forward
  53. ;;    tail-of-plex  - .t
  54. ;;    up-a-level - .u
  55. ;;    last char of cell - +e
  56. ;;
  57. ;;; position (relative to cell start) =
  58. ;;    char-pos, e.g. 28 or C28
  59. ;;    word-num, e.g. W5
  60. ;;    line-num, e.g. L2
  61. ;;    paragraph-num, e.g. P3
  62. ;;    regexp-match, e.g. "regexp"
  63. ;;
  64. ;; DESCRIP-END.
  65.  
  66. ;;; ************************************************************************
  67. ;;; Public functions
  68. ;;; ************************************************************************
  69.  
  70. ;;;###autoload
  71. (defun klink:create (reference)
  72.   "Insert at point an implicit link to REFERENCE.
  73. REFERENCE should be a cell-ref or a list of (filename cell-ref).
  74. See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
  75.   (interactive
  76.    ;; Don't change the name or delete default-dir used here.  It is referenced
  77.    ;; in "hargs.el" for argument getting.
  78.    (let ((default-dir default-directory))
  79.      (hargs:iform-read
  80.       (list 'interactive "*+LInsert at point a link to: "))))
  81.   (barf-if-buffer-read-only)
  82.   (let ((default-dir default-directory)
  83.     (file-ref (if (listp reference) (car reference)))
  84.     (cell-ref (cond ((listp reference)   (car (cdr reference)))
  85.             ((stringp reference) reference)
  86.             (t (error "(klink:create) Invalid reference, '%s'"
  87.                   reference)))))
  88.     ;; Don't need filename if link is to a cell in current buffer.
  89.     (if (and file-ref (equal buffer-file-name
  90.                  (expand-file-name file-ref default-directory)))
  91.     (setq file-ref nil))
  92.     (cond (file-ref
  93.        (setq file-ref (hpath:relative-to file-ref))
  94.          ;; "./" prefix, if any.
  95.        (if (string-match "^\\./" file-ref)
  96.            (setq file-ref (substring file-ref (match-end 0))))
  97.        (insert "<" file-ref)
  98.        (if cell-ref (insert ", " cell-ref))
  99.        (insert ">"))
  100.       (cell-ref (insert "<@ " cell-ref ">"))
  101.       (t  (error "(klink:create) Invalid reference, '%s'" reference)))))
  102.  
  103. (defun klink:at-p ()
  104.   "Return non-nil iff point is within a klink.
  105. See documentation for `actypes::link-to-kotl' for valid klink formats.
  106. Value returned is a list of: link-label, link-start-position, and
  107. link-end-position, (including delimiters)."
  108.   (let (bol klink referent)
  109.     (if (and
  110.      ;; If this is an OO-Browser listing buffer, ignore anything that
  111.      ;; looks like a klink, e.g. a C++ <template> class.
  112.      (if (fboundp 'br-browser-buffer-p)
  113.          (not (br-browser-buffer-p))
  114.        t)
  115.      ;; Don't match to C/C++ lines like:  #include < path >
  116.      (save-excursion
  117.        (beginning-of-line)
  118.        (setq bol (point))
  119.        (require 'hmouse-tag)
  120.        (not (looking-at smart-c-include-regexp)))
  121.      (save-excursion
  122.        ;; Don't match Elisp print objects such as #<buffer>
  123.        (and (search-backward "<" bol t)
  124.         (/= (preceding-char) ?#)
  125.         ;; Don't match to \<(explicit)> Hyperbole buttons
  126.         (/= (char-after (1+ (point))) ?\()))
  127.      (setq klink (hbut:label-p t "<" ">" t))
  128.      (stringp (setq referent (car klink)))
  129.      ;; Eliminate matches to e-mail address like, <user@domain>.
  130.      (not (string-match "[^<> \t\n][!&@]" referent)))
  131.     klink)))
  132.  
  133. ;;; ************************************************************************
  134. ;;; Hyperbole type definitions
  135. ;;; ************************************************************************
  136.  
  137. (defib klink ()
  138.   "Follows a link delimited by <> to a koutline cell.
  139. See documentation for `actypes::link-to-kotl' for valid link specifiers."
  140.   (let* ((link-and-pos (klink:at-p))
  141.      (link (car link-and-pos))
  142.      (start-pos (car (cdr link-and-pos))))
  143.     (if link
  144.     (progn (ibut:label-set link-and-pos)
  145.            (hact 'klink:act link start-pos)))))
  146.  
  147. (defact link-to-kotl (link)
  148.   "Displays at the top of another window the referent pointed to by LINK.
  149. LINK may be of any of the following forms, with or without delimiters:
  150.   < pathname [, cell-ref] >
  151.   < [-!&] pathname >
  152.   < @ cell-ref >
  153.  
  154. See documentation for 'kcell:ref-to-id' for valid cell-ref formats."
  155.  
  156.   (interactive "sKotl link specifier: ")
  157.   (or (stringp link) (error "(link-to-kotl): Non-string link argument, %s"
  158.                 link))
  159.   (cond
  160.    ((string-match "\\`<?\\s *@\\s *\\([*.=0-9a-zA-Z]+\\)\\s *>?\\'" link)
  161.     ;; < @ cell-ref >
  162.     (hact 'link-to-kcell
  163.       nil
  164.       (kcell:ref-to-id
  165.        (substring link (match-beginning 1) (match-end 1)))))
  166.    ((string-match
  167.      "\\`<?\\s *\\([^ \t\n,<>]+\\)\\s *\\(,\\s *\\([*.=0-9a-zA-Z]+\\)\\)?\\s *>?\\'"
  168.      link)
  169.     ;; < pathname [, cell-ref] >
  170.     (hact 'link-to-kcell
  171.       (substring link (match-beginning 1) (match-end 1))
  172.       (if (match-end 3)
  173.           (kcell:ref-to-id
  174.            (substring link (match-beginning 3) (match-end 3))))))
  175.    ((string-match
  176.      "\\`<?\\s *\\(\\([-!&]\\)?\\s *[^ \t\n,<>]+\\)\\s *>?\\'" link)
  177.     ;; < [-!&] pathname >
  178.     (hpath:find-other-window
  179.      (substring link (match-beginning 1) (match-end 1))))
  180.    (t (error "(link-to-kotl): Invalid link specifier, %s" link))))
  181.  
  182. ;;; ************************************************************************
  183. ;;; Private functions
  184. ;;; ************************************************************************
  185.  
  186. (defun klink:act (link start-pos)
  187.   (let ((obuf (current-buffer)))
  188.     ;; Perform klink's action which is to jump to link referent.
  189.     (hact 'link-to-kotl link)
  190.     ;; Update klink label if need be, which might be in a different buffer
  191.     ;; than the current one.
  192.     (klink:update-label link start-pos obuf)))
  193.  
  194. (defun klink:replace-label (klink link-buf start new-label)
  195.   (save-excursion
  196.     (set-buffer link-buf)
  197.     (if buffer-read-only
  198.     (message "Relative label should be `%s' in klink <%s>."
  199.          new-label klink)
  200.       (goto-char start)
  201.       (cond ((or (looking-at "<\\s *@\\s *")
  202.          (looking-at "[^,]+,\\s *"))
  203.          (goto-char (match-end 0))
  204.          (zap-to-char 1 ?=)
  205.          (insert new-label ?=))
  206.         (t nil)))))
  207.  
  208. (defun klink:update-label (klink start link-buf)
  209.   "Update label of KLINK if its relative cell id has changed.
  210. Assume point is in klink referent buffer, where the klink points."
  211.   (if (and (stringp klink)
  212.        (string-match
  213.         "[@,]\\s *\\([*0-9][*.0-9a-zA-Z]*\\)\\s *=\\s *0[0-9]*\\(\\'\\|\\s *,\\)"
  214.         klink))
  215.       ;; Then klink has both relative and permanent ids.
  216.       (let* ((label (substring klink (match-beginning 1) (match-end 1)))
  217.          (new-label (kcell-view:label)))
  218.       (if (and new-label (not (equal label new-label)))
  219.           (klink:replace-label klink link-buf start new-label)))))
  220.  
  221. (provide 'klink)
  222.